home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / exechk.com / MYDATA.INC < prev    next >
Encoding:
Text File  |  1990-12-07  |  3.6 KB  |  119 lines
  1. (*******************************************************************
  2. Variables for demo data.  Can be changed to any type without modifying
  3. the EXECHK code, (up to a limit of 65519 bytes), because the
  4. ExeRead/Write procedures use VAR parameters.
  5. *******************************************************************)
  6. CONST
  7.    MaxLines                  = 4 ;
  8.    NameLength                = 30 ;
  9.    Ok                        : boolean = FALSE ;
  10. TYPE
  11.    NameType                  = array [ 1..MaxLines ] of
  12.                                string [ NameLength ] ;
  13. VAR
  14.    Data                      : NameType ;
  15.    DataLabel                 : NameType ;
  16. (*******************************************************************
  17. Data entry and display screens.
  18. *******************************************************************)
  19. function LabelLength : byte ;
  20. var
  21.    Len ,
  22.    B                         : byte ;
  23. begin
  24.    Len                       := 0 ;
  25.    for B := 1 to MaxLines do
  26.      if length ( DataLabel [ B ] ) > Len then
  27.         Len                  := length ( DataLabel [ B ] ) ;
  28.    LabelLength               := Len ;
  29. end ;
  30. (*******************************************************************
  31. Display Data
  32. *******************************************************************)
  33. procedure MyDataOutput ;
  34. var
  35.    B                         : byte ;
  36. begin
  37.    ClrScr ;
  38.    writeln ( 'This software is licensed to:' ) ;
  39.    writeln ( '-----------------------------' ) ;
  40.    for B := 1 to MaxLines do
  41.    begin
  42.       write ( DataLabel [ B ] : LabelLength , #178 ) ;
  43.       write ( Data [ B ] ) ;
  44.       writeln ;
  45.    end ;
  46.    writeln ( '=============================' ) ;
  47. end ;
  48. (*******************************************************************
  49. INPUT
  50. *******************************************************************)
  51. procedure MyDataInput ;
  52.  
  53. (*******************************************************************
  54. Only allow [Y]es, [N]o or [E]sc
  55. *******************************************************************)
  56. function YesNoEsc : char ;
  57. var
  58.    junk ,
  59.    Ch                        : char ;
  60. begin
  61.    writeln ( 'Press Y to continue, N to re-enter name, or ESC to cancel' ) ;
  62.    while TRUE do
  63.    begin
  64.       Ch                     := ReadKey ;
  65.       if KeyPressed then
  66.          Junk                := ReadKey ;
  67.       Ch                     := UpCase ( Ch ) ;
  68.       if ( Ch = 'Y' ) or ( Ch = 'N' ) or ( Ch = #27 ) then
  69.       begin
  70.          YesNoEsc            := Ch ;
  71.          EXIT ;
  72.       end ;
  73.    end ;
  74. end ;
  75.  
  76. procedure GetUserInfo ;
  77. var
  78.    B                         : byte ;
  79. begin
  80.    for B := 1 to MaxLines do
  81.    begin
  82.       write ( DataLabel [ B ] : LabelLength , #178 ) ;
  83.       readln ( Data [ B ] ) ;
  84.    end ;
  85. end ;
  86.  
  87. begin
  88.    while TRUE do
  89.    begin
  90.       GetUserInfo ;
  91.       MyDataOutput ;
  92.       writeln ( 'Everything OK?' ) ;
  93.       case YesNoEsc of
  94.       'Y' :
  95.          begin
  96.             Ok               := TRUE ;
  97.             EXIT ;
  98.          end ;
  99.       #27 :
  100.          begin
  101.             Ok               := FALSE ;
  102.             EXIT ;
  103.          end ;
  104.       'N' : ;                                    (* Loop *)
  105.       end ;
  106.    end ;
  107. end ;
  108. (*******************************************************************
  109. Initialize demo fields, labels, etc.
  110. *******************************************************************)
  111. procedure MyDataInit ;
  112. begin
  113.    FillChar ( Data , SizeOf ( Data ) , #0 ) ;
  114.    DataLabel [ 1 ]           := 'Name' ;
  115.    DataLabel [ 2 ]           := 'Company' ;
  116.    DataLabel [ 3 ]           := 'City, State' ;
  117.    DataLabel [ 4 ]           := 'Serial #' ;
  118. end ;
  119.